Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/PNL Libraries/MyFullScreen.p

Text File | 1997-05-02 | 5.5 KB | 230 lines | [TEXT/CWIE]

unit MyFullScreen;

interface

    uses
        Quickdraw;

    const
        fade_to_black_time = 500000;
        fade_in_time = 500000;

    const
        kFullScreenOn = true;
        kFullScreenOff = false;
        kDoFade = true;
        kDontFade = false;

    var
        full_screen: boolean;

    procedure StartupFullScreen;
    procedure SetFullScreen( on, fade: boolean; window: WindowPtr );

    procedure FadeTo( percent: integer; time_us: longint );

implementation

    uses
        Types, LowMem, Menus, Timer, Windows,
        GammaPaslib,
        MyStartup, MyAssertions, MyWindows;

    var
        has_gamma: boolean;
        current_fade: integer;

{ /-------------------------------------------------------------------------------------- }
{     Globals for HideMenuBar and ShowMenuBar }
{ /-------------------------------------------------------------------------------------- }

    var

        gOldVisRgn: RgnHandle;    {  visRgn of window before hiding menu bar }
        gOldMBarHeight: integer;
        gFadeWindow: WindowPtr;

{ Hide/ShowMenuBar from SpriteWorld 2.0 }

{ /-------------------------------------------------------------------------------------- }
{     HideMenuBar - expands the vis region of grafPort to cover the entire window, which }
{  will allow you to draw in the top of that window to erase the menu bar. This is a }
{  simple routine designed for programs with only one window that covers the menu bar. }
{  If you need to expand the region of more than one window, you need a different routine. }
{  Be sure to make the window visible before calling this. HideMenuBar returns the }
{  region of the menu bar and corners of the screen, in case you want to erase or }
{  draw in that area. }
{ /-------------------------------------------------------------------------------------- }

    procedure HideMenuBar (grafPort: GrafPtr);
        var
            newVisRgn: RgnHandle;
            savePort: GrafPtr;
    begin
        if (gOldVisRgn <> nil) then begin
            exit(HideMenuBar);
        end;

        GetPort(savePort);
        SetPort(grafPort);

        gOldMBarHeight := LMGetMBarHeight;
        LMSetMBarHeight(0);        {  Keeps things like SuperClock from coming on. }

        {  save off vis region }
        gOldVisRgn := NewRgn;
        CopyRgn(grafPort^.visRgn, gOldVisRgn);

        {  expand the vis region of the port rect to be completely rectangular }
        newVisRgn := NewRgn;
        RectRgn(newVisRgn, grafPort^.portRect);
        CopyRgn(newVisRgn, grafPort^.visRgn);
        DisposeRgn(newVisRgn);

        SetPort(savePort);
    end;

{ /-------------------------------------------------------------------------------------- }
{     ShowMenuBar - restores the grafPort to the way it was before the call to HideMenuBar. }
{     Make sure to call this after every call to HideMenuBar to dispose of gOldVisRgn. }
{ /-------------------------------------------------------------------------------------- }

    procedure ShowMenuBar (grafPort: GrafPtr);
        var
            savePort: GrafPtr;
            junkRgn: RgnHandle;

    begin

        if (gOldVisRgn = nil) then
            exit(ShowMenuBar);

        GetPort(savePort);
        SetPort(grafPort);

        LMSetMBarHeight(gOldMBarHeight);

        {  fill the rounded corners of the screen with black again }
        junkRgn := NewRgn;
        CopyRgn(gOldVisRgn, junkRgn);
        DiffRgn(grafPort^.visRgn, junkRgn, junkRgn);

{$IFC undefined THINK_Pascal}
        FillRgn(junkRgn, qd.black);
{$ELSEC}
        FillRgn(junkRgn, black);
{$ENDC}

        DisposeRgn(junkRgn);

        {  restore the old vis region }
        CopyRgn(gOldVisRgn, grafPort^.visRgn);
        DisposeRgn(gOldVisRgn);
        gOldVisRgn := nil;

        DrawMenuBar;

        SetPort(savePort);
    end;

    procedure FadeTo( percent: integer; time_us: longint );
        var
            last, now: UnsignedWide;
            junk: OSErr;
    begin
        if has_gamma & (percent <> current_fade) then begin
            time_us := time_us div abs(percent - current_fade);
            Microseconds( last );
            while current_fade <> percent do begin
                if percent > current_fade then begin
                    Inc(current_fade);
                end else begin
                    Dec(current_fade);
                end;
                junk := DoGammaFade( current_fade );
                repeat
                    Microseconds( now );
                until now.lo - last.lo > time_us;
                last.lo := last.lo + time_us;
            end;
        end;
        current_fade := percent;
    end;

    procedure SetFullScreen( on, fade: boolean; window: WindowPtr );
        var
            frame: Rect;
    begin
        if on <> full_screen then begin

            if window = nil then begin
                Assert( gFadeWindow <> nil );
                window := gFadeWindow;
            end else begin
                gFadeWindow := window;
            end;

            if fade then begin
                FadeTo( 0, fade_to_black_time );
            end;

            if on then begin
                UnionRect( GetGrayRgn^^.rgnBBox, qd.screenBits.bounds, frame );
                SetWindowRect( window, frame );
                LMSetPaintWhite( 0 );
                ShowWindow( window );
                HideMenuBar( window );
                SetPort( window );
                FillRect( frame, qd.black );
                LMSetPaintWhite( -1 );
                if fade then begin
                    FadeTo( 100, 0 );
                end;
            end else begin
                ShowMenuBar( window );
                HideWindow( window );
                DrawMenuBar;
                if fade then begin
                    FadeTo( 100, fade_in_time );
                end;
            end;

            full_screen := on;
        end;
    end;

    function InitFullScreen( var msg: integer ): OSStatus;
    begin
{$unused(msg)}
        has_gamma := IsGammaAvailable;
//        has_gamma := false;

        current_fade := 100;
        full_screen := false;
        gOldVisRgn := nil;
        if has_gamma then begin
            has_gamma := has_gamma & (SetupGammaTools = noErr);
        end;
        InitFullScreen := noErr;
    end;

    procedure FinishFullScreen;
        var
            junk: OSErr;
    begin
        if full_screen then begin
            SetFullScreen( kFullScreenOff, kDontFade, gFadeWindow );
        end;
        if has_gamma then begin
            FadeTo( 100, 0 );
            junk := DisposeGammaTools;
        end;
    end;

    procedure StartupFullScreen;
    begin
        SetStartup( InitFullScreen, nil, 0, FinishFullScreen );
    end;

end.